Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue25/survive/MYDS.PAS

Pascal/Delphi Source File | 1997-07-21 | 8.5 KB | 290 lines

unit MyDS;

interface

uses
  Classes, DB, SysUtils;

type
  PExtraRecInfo = ^TExtraRecInfo;
  TExtraRecInfo = record
      RecordNumber: LongInt;
      BookmarkFlag: TBookmarkFlag;
    end;

  TBookmarkInfo = LongInt;

  TMyDataSet = class(TDataSet)
    private
      FBookmarkOffset: LongInt;  { Offset to bookmark data in recbuf }
      FCursorOpen: Boolean;      { True if cursor is open }
      FInternalFile: file;       { File variable }
      FRecSize: Word;            { Physical size of record }
      FRecBufSize: Word;         { Total size of recbuf }
      FExtraRecInfoOffset: Word; { Offset to extra rec info in recbuf }
      FTableName: TFileName;     { External filename to open }
    protected

      { basic file reading and navigation }
      function AllocRecordBuffer: PChar; override;
      procedure FreeRecordBuffer(var Buffer: PChar); override;
      function GetCurrentRecord(Buffer: PChar): Boolean; override;
      function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
      function GetRecordCount: Integer; override;
      function GetRecordSize: Word; override;
      function GetRecNo: Integer; override;
      procedure InternalClose; override;
      procedure InternalFirst; override;
      procedure InternalLast; override;
      procedure InternalOpen; override;
      function IsCursorOpen: Boolean; override;

      { bookmarks }
      function BookmarkValid(Bookmark: TBookmark): Boolean; override;
      function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer; override;
      procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
      function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
      procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
      procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
      procedure InternalGotoBookmark(Bookmark: Pointer); override;
      procedure InternalSetToRecord(Buffer: PChar); override;

      { basic file modification }
      procedure InternalInitRecord(Buffer: PChar); override;
      procedure InternalEdit; override;
      procedure InternalDelete; override;
      procedure InternalPost; override;
    public
      {TDataSet properties}
      property RecordSize: Word read GetRecordSize write FRecSize;
      {descendant properties}
      property TableName: TFileName read FTableName write FTableName;
    end;

implementation

function TMyDataSet.AllocRecordBuffer: PChar;
begin
  Result := StrAlloc(FRecBufSize);
  FillChar(Result^, FRecBufSize, #0);
end;

function TMyDataSet.BookmarkValid(Bookmark: TBookmark): Boolean;
var
  DelFlag: Byte;
begin
  Result := Assigned(Bookmark) and
            (TBookmarkInfo(Bookmark^) > 0) and
            (TBookmarkInfo(Bookmark^) <= RecordCount);
  if Result then begin
    CursorPosChanged;  { physical position no longer matches logical position }
    try
      Seek(FInternalFile, TBookmarkInfo(Bookmark^) * FRecSize);
      BlockRead(FInternalFile, DelFlag, 1);
      Result := DelFlag = 0;  { check for a deleted record }
    except
      Result := False;
    end;
  end;
end;

function TMyDataSet.CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer;
begin
  { bookmarks are equal if they are both nil or they both have the same value }
  if Bookmark1 = Bookmark2 then
    Result := 0
  else begin
    Result := 1;
    if Assigned(Bookmark1) and Assigned(Bookmark2) then
      if TBookmarkInfo(Bookmark1^) = TBookmarkInfo(Bookmark2^) then
        Result := 0;
  end;
end;

procedure TMyDataSet.FreeRecordBuffer(var Buffer: PChar);
begin
  StrDispose(Buffer);
end;

procedure TMyDataSet.GetBookmarkData(Buffer: PChar; Data: Pointer);
begin
  Move(Buffer[FBookmarkOffset], Data^, BookmarkSize);
end;

function TMyDataSet.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
begin
  Result := PExtraRecInfo(Buffer + FExtraRecInfoOffset).BookmarkFlag;
end;

function TMyDataSet.GetCurrentRecord(Buffer: PChar): Boolean;
begin
  Result := False;
  if not IsEmpty then begin
    Result := True;
    Move(ActiveBuffer^, Buffer^, FRecSize);  {not sure here, buffer may contain internal data}
  end;
end;

function TMyDataSet.GetRecNo: Integer;
begin
  { Because of Delphi's internal record buffering, we must read the stored
    record number, not the current physical file position }
  Result := PExtraRecInfo(ActiveBuffer + FExtraRecInfoOffset)^.RecordNumber;
end;

function TMyDataSet.GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult;
var
  FilePosition: LongInt;
begin
  Result := grOk;
  case GetMode of
    gmCurrent:
      begin
        Seek(FInternalFile, FilePos(FInternalFile) - FRecSize);
        BlockRead(FInternalFile, Buffer^, FRecSize);
        if Byte(Buffer^) <> 0 then  { deleted rec? }
          Result := grError;
      end;
    gmNext:
      { read next record, skipping deleted records }
      repeat
        if System.Eof(FInternalFile) then
          Result := grEOF
        else
          BlockRead(FInternalFile, Buffer^, FRecSize);
      until (Result <> grOk) or (Byte(Buffer^) = 0);
    gmPrior:
      repeat
        FilePosition := FilePos(FInternalFile);
        if FilePosition < (2 * FRecSize) then
          Result := grBOF
        else begin
          if Eof then
            Seek(FInternalFile, FileSize(FInternalFile) - FRecSize)
          else
            Seek(FInternalFile, FilePosition - (2 * FRecSize));
          BlockRead(FInternalFile, Buffer^, FRecSize);
        end;
      until (Result <> grOk) or (Byte(Buffer^) = 0);
    else
      Result := grError;
  end;

  if Result = grOk then begin
    with PExtraRecInfo(Buffer + FExtraRecInfoOffset)^ do begin
      RecordNumber := (FilePos(FInternalFile) div FRecSize) - 1;
      BookmarkFlag := bfCurrent;
      SetBookmarkData(Buffer, @RecordNumber);
    end;
  end;
end;

function TMyDataSet.GetRecordCount: Integer;
begin
  Result := FileSize(FInternalFile) div FRecSize;
end;

function TMyDataSet.GetRecordSize: Word;
begin
  Result := FRecSize;
end;

procedure TMyDataSet.InternalClose;
begin
  CloseFile(FInternalFile);
  FCursorOpen := False;
end;

procedure TMyDataSet.InternalDelete;
var
  DelFlag: Byte;
  FilePosition: LongInt;
begin
  FilePosition := FilePos(FInternalFile) - FRecSize;
  Seek(FInternalFile, FilePosition);
  DelFlag := 255;
  BlockWrite(FInternalFile, DelFlag, 1);
  Seek(FInternalFile, FilePosition + FRecSize);
end;

procedure TMyDataSet.InternalEdit;
begin
  { Refresh the current record }
  Seek(FInternalFile, FilePos(FInternalFile) - FRecSize);
  BlockRead(FInternalFile, ActiveBuffer^, FRecSize);
end;

procedure TMyDataSet.InternalFirst;
begin
  Seek(FInternalFile, 0);
end;

procedure TMyDataSet.InternalInitRecord(Buffer: PChar);
begin
  FillChar(Buffer^, FRecBufSize, #0);
end;

procedure TMyDataSet.InternalGotoBookmark(Bookmark: Pointer);
{ position physical file to bookmarked record }
begin
  { Position AFTER the record, as though we just read it }
  Seek(FInternalFile, (TBookmarkInfo(Bookmark^) + 1) * FRecSize);
end;

procedure TMyDataSet.InternalLast;
begin
  Seek(FInternalFile, FileSize(FInternalFile));  { force eof condition }
end;

procedure TMyDataSet.InternalOpen;
begin
  BookmarkSize := SizeOf(TBookmarkInfo);
  FRecBufSize := FRecSize + SizeOf(TExtraRecInfo) + BookmarkSize;

  FExtraRecInfoOffset := FRecSize;
  FBookmarkOffset := FExtraRecInfoOffset + SizeOf(TExtraRecInfo);

  AssignFile(FInternalFile, FTableName);
  Reset(FInternalFile, 1);   { Open a file of bytes }
  FCursorOpen := True;
end;

procedure TMyDataSet.InternalPost;
begin
  case State of
    dsEdit:
      begin
        Seek(FInternalFile, FilePos(FInternalFile) - FRecSize);
        BlockWrite(FInternalFile, ActiveBuffer^, FRecSize);
      end;
    dsInsert:
      begin
        Byte(ActiveBuffer^) := 0;  { reset deleted flag }
        Seek(FInternalFile, FileSize(FInternalFile));
        BlockWrite(FInternalFile, ActiveBuffer^, FRecSize);
      end;
  end;
end;

procedure TMyDataSet.InternalSetToRecord(Buffer: PChar);
begin
  InternalGotoBookmark(Buffer + FBookmarkOffset);
end;

function TMyDataSet.IsCursorOpen: Boolean;
begin
  Result := FCursorOpen;
end;

procedure TMyDataSet.SetBookmarkData(Buffer: PChar; Data: Pointer);
begin
  Move(Data^, Buffer[FBookmarkOffset], BookmarkSize);
end;

procedure TMyDataSet.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag);
begin
  PExtraRecInfo(Buffer + FExtraRecInfoOffset).BookmarkFlag := Value;
end;

end.